home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22s.zip / DISPLAY2.4TH < prev    next >
Text File  |  1994-10-30  |  4KB  |  118 lines
  1. \ FORTH COMPILER  DISPLAY LIBRARY                 05/13/93
  2.  
  3. 0 [IF]
  4. COPYRIGHT 1993 (C) BY THOMAS ALMY.  ALL RIGHTS RESERVED
  5. Permission is granted to registered users of ForthCMP to sell or distribute
  6. computer programs incorporating the compiled contents of this file.
  7.  
  8. Fast Terminal output for IBM pc or compatibles.
  9. Works with monochrome or color monitors, any text display mode.
  10. EMIT generates all 256 characters -- no control functions.
  11.  
  12. Include file DISPLAY1 at start of program.
  13. Include this file before FORTHLIB
  14. When used with FACIL, include DISPLAY2 before FACIL2
  15. Define constant VID-DELAY non-zero for vertical retrace blanking
  16. Execute SETUP-VID at program start, and UNSETUP-VID at finish
  17.  
  18. This library defines EMIT, TYPE, CS:TYPE, PAGE, AT-XY, FOREGROUND,
  19. BACKGROUND, INTENSITY, -INTENSITY, BLINK, -BLINK, as in
  20. PC/Forth. DO NOT use CONSOLE PRINTER and/or MESSAGES!
  21.  
  22.  
  23. [THEN]
  24.  
  25. 10 HEX
  26. 1 0 IN/OUT
  27. : setcursor ( DISPL -- )   DUP cursor !  crtstart +
  28.    2/ DUP 0F crtport @ PC! crtport @ 1+ PC!
  29.    >< 0E crtport @ PC! crtport @ 1+ PC! ;
  30. : AT-XY ( X Y -- ) c/l * + 2* setcursor ;
  31. FIND VID-DELAY [IF] DROP [ELSE] 0 CONSTANT VID-DELAY [THEN]
  32. 0 0 IN/OUT
  33. : SETUP-VID
  34.  40 49 C@L 7 = IF 3B4 crtport ! B000 vidseg ! \ MONOCHROME
  35.      ELSE \ COLOR
  36.      40 84 C@L ?DUP IF 1+ TO l/s THEN THEN \ EGA/VGA 
  37.      40 4A @L TO c/l     \ characters per line
  38.      c/l l/s * TO c/s   c/l l/s 1- * 2* TO c/sm1
  39.  40 4E @L TO crtstart
  40.  40 50 C@L 40 51 C@L AT-XY
  41.  vidseg @  c/sm1 1+ crtstart + C@L style ! ;
  42. 0 0 IN/OUT
  43. CODE UNSETUP-VID  cursor [] AX MOV  ' c/l [] BX MOV DX DX XOR
  44.   AX 1 SAR  BX IDIV
  45.   AL DH MOV  2 # AH MOV BH BH XOR  10 INT  RET END-CODE
  46. CODE scrmove  ( source dest wordCount -- )
  47.     BX POP CX POP DI POP SI POP
  48.     ' crtstart [] SI ADD
  49.     ' crtstart [] DI ADD
  50.     LOOP IF,  DS PUSHSEG
  51. VID-DELAY [IF]  B800 # vidseg [] CMP  =0 IF,  3DA # DX MOV
  52.    BEGIN,  BYTE [DX] IN  8 # AL TEST  =0 ~ UNTIL,
  53.       DX DEC  DX DEC  21 # AL MOV  BYTE [DX] OUT  THEN, [THEN]
  54.               vidseg [] AX MOV   AX DS >SEG  AX ES >SEG
  55.               REPZ MOVS  DS POPSEG
  56. VID-DELAY [IF]  B800 # vidseg [] CMP  =0 IF,  3D8 # DX MOV
  57.       29 # AL MOV  BYTE [DX] OUT  THEN, [THEN]
  58.       THEN, BX JMPI END-CODE
  59. 2 0 IN/OUT
  60. CODE scrfill ( source wordCount -- )
  61.     vidseg [] ES >SEG
  62.     BX PUSH  ' crtstart [] BX ADD
  63.     20 # BYTE ES: [BX] MOV
  64.     style [] CL MOV  CL ES: 1 +[BX] MOV
  65.     BX POP
  66.     BX PUSH  BX INC BX INC BX PUSH  AX DEC AX PUSH
  67.     CALL' scrmove   RET  END-CODE
  68. 0 0 IN/OUT
  69. : scrollup  c/l 2*  0  c/sm1 2/ scrmove
  70.       c/sm1 c/l  scrfill
  71.       c/sm1 cursor ! ;
  72. U: PAGE  0  c/s  scrfill  0 setcursor ;
  73. U: FOREGROUND 0F AND style @ F0 AND OR style ! ;
  74. U: BACKGROUND 7 AND 4 << style @ 0F AND OR style ! ;
  75. PRIMITIVE U: BLINK 80 style CSET ;
  76. PRIMITIVE U: -BLINK 80 style CRESET ;
  77. PRIMITIVE U: INTENSITY  8 style CSET ;
  78. PRIMITIVE U: -INTENSITY 8 style CRESET ;
  79.  
  80. : EMIT  cursor @  c/s 2* >= IF scrollup THEN
  81.         vidseg @ cursor @ crtstart + C!L
  82.         style @ vidseg @ cursor @ 1+ crtstart + C!L
  83.         cursor @ CELL+ setcursor ;
  84. : CR   cursor @  c/l 2*  U/  1+  c/l 2*  *
  85.     DUP c/s 2* = IF DROP scrollup  cursor @ THEN
  86.     setcursor ;
  87.  
  88. VID-DELAY 0= [IF]
  89. 2 1 IN/OUT
  90. CODE (type) ( AX has count, BX has string )
  91.     cursor [] DI MOV  AX CX MOV  style [] AH MOV  BX SI MOV
  92.     ' crtstart [] DI ADD
  93.     vidseg [] ES >SEG  LOOP IF, BEGIN,  BYTE LODS
  94.     STOS  LOOP ~ UNTIL,  THEN,
  95.     DI AX MOV   ' crtstart [] AX SUB
  96.     RET  END-CODE
  97. SEPDSEG? 0= [IF] CODE CS:TYPE END-CODE [THEN]
  98. : TYPE c/s cursor @ - OVER 2* < IF ( too big )
  99.        0 ?DO COUNT EMIT LOOP DROP
  100.        ELSE (type) setcursor THEN ;
  101. [THEN]
  102.  
  103. VID-DELAY 0= [IF]
  104. SEPDSEG? [IF]
  105. 2 1 IN/OUT
  106. CODE (cs:type) ( AX has count, BX has string )
  107.     cursor [] DI MOV  AX CX MOV  style [] AH MOV  BX SI MOV
  108.     ' crtstart [] DI ADD
  109.     vidseg [] ES >SEG  LOOP IF, BEGIN, CS: BYTE LODS  STOS
  110.        LOOP ~ UNTIL,  THEN,
  111.     DI AX MOV   ' crtstart [] AX SUB
  112.     RET  END-CODE
  113. : CS:TYPE c/s 2* cursor @ - OVER 2* < IF ( too big )
  114.        0 ?DO CS: COUNT EMIT LOOP DROP
  115.        ELSE (cs:type) setcursor THEN ;
  116. [THEN]   [THEN]
  117. 0A = [IF] DECIMAL [THEN]
  118.